;;; camera.lisp
;;;
;;; Something is weird with XMLisp's camera.

(in-package :app.dt)

;;; Action so we do not conflict with XMLisp's camera definition
(defclass action-camera (spatial)
  ((r :accessor camera-r :initarg :r :type vector
      :initform (vector 1.0d0 0.0d0 0.0d0))
   (d :accessor camera-d :initarg :d :type vector
      :initform (vector 0.0d0 0.0d0 -1.0d0))
   (u :accessor camera-u :initarg :u :type vector 
       :initform (vector 0.0d0 1.0d0 0.0d0))
   (eye :accessor camera-eye :initarg :eye :type vector
	:initform (vector 0.0d0 0.0d0 5.0d0))
   (frustum :accessor camera-frustum :initarg :frustum)
   (fovy :accessor camera-fovy :initarg :fovy :initform 60.0d0)
   (aspect :accessor camera-aspect :initarg :aspect :initform 1.0d0)
   (near :accessor camera-near :initarg :near :initform 0.5d0)
   (vmatrix :accessor vmatrix :initarg :vmatrix :initform (zero-matrix 4))
   (pmatrix :accessor pmatrix :initarg :pmatrix :initform (zero-matrix 4))
   (far :accessor camera-far :initarg :far :initform 100.0d0)))

(defmethod update-view-matrix ((c action-camera))
  (with-slots (vmatrix r d u eye) c
    (setf (mref vmatrix 0 0) (mref r 0)
	  (mref vmatrix 0 1) (mref u 0)
	  (mref vmatrix 0 2) (mref d 0)
	  (mref vmatrix 0 3) 0.0
    
	  (mref vmatrix 1 0) (mref r 1)
	  (mref vmatrix 1 1) (mref u 1)
	  (mref vmatrix 1 2) (mref d 1)
	  (mref vmatrix 1 3) 0.0

	  (mref vmatrix 2 0) (mref r 2)
	  (mref vmatrix 2 1) (mref u 2)
	  (mref vmatrix 2 2) (mref d 2)
	  (mref vmatrix 2 3) 0.0

	  (mref vmatrix 3 0) (- (dot-product r eye))
	  (mref vmatrix 3 1) (- (dot-product u eye))
	  (mref vmatrix 3 2) (- (dot-product d eye))
	  (mref vmatrix 3 3) 1.0)))

(defmethod update-projection-matrix ((c action-camera))
  (with-slots (pmatrix near far) c
    (multiple-value-bind (umin umax rmin rmax) (frustum-coordinates c)
      (let* ((dmax far)
	     (dmin near)
	     (inv-rdiff (/ 1.0 (- rmax rmin)))
	     (inv-udiff (/ 1.0 (- umax umin)))
	     (inv-ddiff (/ 1.0 (- dmax dmin))))
	;; Matrix for perspective transformation
	(setf (mref pmatrix 0 0) (* 2.0 dmin inv-rdiff)
	      (mref pmatrix 0 1) 0.0
	      (mref pmatrix 0 2) 0.0
	      (mref pmatrix 0 3) 0.0

	      (mref pmatrix 1 0) 0.0
	      (mref pmatrix 1 1) (* 2.0 dmin inv-udiff)
	      (mref pmatrix 1 2) 0.0
	      (mref pmatrix 1 3) 0.0

	      (mref pmatrix 2 0) (* inv-rdiff (- (+ rmin rmax)))
	      (mref pmatrix 2 1) (* inv-udiff (- (+ umin umax)))
	      (mref pmatrix 2 2) (* inv-ddiff dmax)
	      (mref pmatrix 2 3) 1.0

	      (mref pmatrix 3 0) 0.0
	      (mref pmatrix 3 1) 0.0
	      (mref pmatrix 3 2) (* (- dmax) dmin inv-ddiff)
	      (mref pmatrix 3 3) 0.0)))))


(defmethod frustum-coordinates ((c action-camera))
  (with-slots (r u d eye near fovy aspect frustum) c
    (let* ((near near) (fovy fovy) (aspect aspect) ; Because strange things happen if I don't.
	   (umax (/ (* near (tan (lib.gl::deg-to-rad fovy))) 2.0))
	   (umin (- umax))
	   (rmax (* umax aspect))
	   (rmin (- rmax)))
      (values umin umax rmin rmax))))

(defmethod near-plane ((c action-camera))
  (first (compute-frustum c)))

(defmethod compute-frustum ((c action-camera))
  (with-slots (r u d eye near far fovy aspect frustum) c
    (let* ((near near) (far far) (fovy fovy) (aspect aspect) ; Because strange things happen if I don't.
	   (umax (/ (* near (tan (lib.gl::deg-to-rad fovy))) 2.0))
	   (umin (- umax))
	   (rmax (* umax aspect))
	   (rmin (- rmax))
	   (v_bl (m+ eye (m* near d) (m* umin u) (m* rmin r)))
	   (v_tl (m+ eye (m* near d) (m* umax u) (m* rmin r)))
	   (v_br (m+ eye (m* near d) (m* umin u) (m* rmax r)))
	   (v_tr (m+ eye (m* near d) (m* umax u) (m* rmax r)))
	   (ratio (/ far near))
	   (w_bl (m+ eye (m* ratio (m+ (m* near d) (m* umin u) (m* rmin r)))))
	   (w_tl (m+ eye (m* ratio (m+ (m* near d) (m* umax u) (m* rmin r)))))
	   (w_br (m+ eye (m* ratio (m+ (m* near d) (m* umin u) (m* rmax r)))))
	   (w_tr (m+ eye (m* ratio (m+ (m* near d) (m* umax u) (m* rmax r))))))
;      (format t "Frustum plane points~% near:(~A, ~A, ~A, ~A)~% far:(~A, ~A, ~A, ~A)~%" v_bl v_tl v_br v_tr
;	      w_bl w_tl w_br w_tr)
      ;; (format t "d:~A u:~A r:~A  fovy:~A~%" d u r fovy)
      ;; (format t "near:~A  far:~A  umin:~A  umax:~A  rmin:~A  rmax:~A~%" near far umin umax rmin rmax)
      ;; (format t "normals- left:~A  right:~A  bottom:~A  top:~A~%" (m- (m* near r) (m* rmin d))
      ;; (m- (m* rmax d) (m* near r))
      ;; (m- (m* near u) (m* umin d))
      ;; (m- (m* umax d) (m* near u)))
      (setf frustum (list v_bl v_tl v_br v_tr w_bl w_tl w_br w_tr))
      (list  (make-instance 'plane :plane-normal d :point (m+ eye (m* near d))) ; near plane
	     (make-instance 'plane :plane-normal (mneg d) :point (m+ eye (m* far d))) ; far plane
	     (make-instance 'plane 
			    :plane-normal (m- (m* near r) (m* rmin d))
			    :point (copy-vector eye)) ; left plane
	     (make-instance 'plane
			    :plane-normal (m- (m* rmax d) (m* near r))
			    :point (copy-vector eye)) ; right plane
	     (make-instance 'plane 
			    :plane-normal (m- (m* near u) (m* umin d))
			    :point (copy-vector eye)) ; bottom plane
	     (make-instance 'plane
			    :plane-normal (m- (m* umax d) (m* near u))
			    :point (copy-vector eye)))))) ; top plane

(defmethod update-projection ((c action-camera))
  (with-slots (fovy aspect near far) c
    (gl:matrix-mode :projection)
    (gl:load-identity)
    #-linux-target
    (glu:perspective fovy aspect near far)
    ;#+linux-target
    ;()
    (gl:matrix-mode :modelview)))

(defmethod update-view ((c action-camera))
  ;; Not exactly shader friendly
  (with-slots (r u d eye) c
    (let ((center (m+ eye d)))
      ;; set the Projection matrix
      (gl:load-identity)
      ;; set the View Matrix
      ;(format t "Rendering camera (r:~A, u:~A, d:~A) with eye=~A.~%" r u d eye)
      (glu:look-at (x eye) (y eye) (z eye)
		   (x center) (y center) (z center)
		   (x u) (y u) (z u)))))

(defmethod reset-camera ((c action-camera))
  (with-slots (eye r u d) c
    (setf eye #(0.0d0 0.0d0 0.0d0)
	  r #(1.0d0 0.0d0 0.0d0)
	  u #(0.0d0 1.0d0 0.0d0)
	  d #(0.0d0 0.0d0 -1.0d0))))
			 
(defmethod aim-camera ((cam action-camera) &key Eye-X Eye-Y Eye-Z
		       Center-X Center-Y Center-Z
		       Up-X Up-Y Up-Z
		       Fovy Aspect Near Far
		       Animation-Time)
  (declare (ignore animation-time))
  (when aspect
    (setf (camera-aspect cam) aspect))
  (when fovy
    (setf (camera-fovy cam) fovy))
  (when near
    (setf (camera-near cam) near))
  (when far
    (setf (camera-far cam) far))
  cam)
      
;;; These next three are from XMLisp, but one can also find a good
;;; amount of information on cartesian and polar coordinates at
;;; http://wikipedia.org
(defun cartesian->polar (pos)
  "
  in: pos: Vector for position.
  out: r azimuth elevation: float.
  Convert cartesian into polar coordinates."
  ;; oh the fun of dealing with special cases!
  ;; does not work if zenith > pi / 2
  (assert (not (and (zerop (x pos)) (zerop (y pos)))))
  (let* ((r (magnitude pos))
	 (azimuth (atan (y pos) (x pos)))
	 (elevation (acos (/ (z pos) r))))
    (values r azimuth elevation)))

(defun polar->cartesian (r theta phi)
  "in:  Radius, theta (Azimuth), phi (Zenith) float.
  out: pos: vector float.
  Convert polar to carthesian coordinates."  
  (vector (* R (sin theta) (cos phi))
	  (* R (sin phi))
	  (* R (cos theta) (cos phi))))
